Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH3/SRC/RICH.FRM

Text File | 1996-01-29 | 15KB | 524 lines

VERSION 4.00
Begin VB.Form RichForm
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0C0C0&
   Caption         =   "Rich"
   ClientHeight    =   5310
   ClientLeft      =   1935
   ClientTop       =   915
   ClientWidth     =   6165
   Height          =   6000
   Left            =   1875
   LinkTopic       =   "Form1"
   ScaleHeight     =   5310
   ScaleWidth      =   6165
   Top             =   285
   Width           =   6285
   Begin VB.Frame Frame5
      Caption         =   "Color"
      Height          =   650
      Left            =   0
      TabIndex        =   18
      Top             =   2450
      Width           =   1935
      Begin VB.Label ColorSwatch
         BackColor       =   &H00FF00FF&
         Height          =   255
         Index           =   5
         Left            =   1440
         TabIndex        =   24
         Tag             =   "&H00FF00FF"
         Top             =   240
         Width           =   255
      End
      Begin VB.Label ColorSwatch
         BackColor       =   &H0000FFFF&
         Height          =   255
         Index           =   4
         Left            =   1200
         TabIndex        =   23
         Tag             =   "&H0000FFFF"
         Top             =   240
         Width           =   255
      End
      Begin VB.Label ColorSwatch
         BackColor       =   &H00FFFF00&
         Height          =   255
         Index           =   3
         Left            =   960
         TabIndex        =   22
         Tag             =   "&H00FFFF00"
         Top             =   240
         Width           =   255
      End
      Begin VB.Label ColorSwatch
         BackColor       =   &H0000FF00&
         Height          =   255
         Index           =   2
         Left            =   720
         TabIndex        =   21
         Tag             =   "&H0000FF00"
         Top             =   240
         Width           =   255
      End
      Begin VB.Label ColorSwatch
         BackColor       =   &H000000FF&
         Height          =   255
         Index           =   1
         Left            =   480
         TabIndex        =   20
         Tag             =   "&H000000FF"
         Top             =   240
         Width           =   255
      End
      Begin VB.Label ColorSwatch
         BackColor       =   &H00000000&
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   19
         Tag             =   "&H80000012"
         Top             =   240
         Width           =   255
      End
   End
   Begin VB.Frame Frame4
      Caption         =   "Alignment"
      Height          =   1095
      Left            =   0
      TabIndex        =   14
      Top             =   4220
      Width           =   1935
      Begin VB.OptionButton AlignOption
         Caption         =   "Center"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   17
         Top             =   720
         Width           =   1600
      End
      Begin VB.OptionButton AlignOption
         Caption         =   "Right"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   16
         Top             =   480
         Width           =   1600
      End
      Begin VB.OptionButton AlignOption
         Caption         =   "Left"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   15
         Top             =   240
         Value           =   -1  'True
         Width           =   1600
      End
   End
   Begin VB.Frame Frame3
      Caption         =   "Paragraph"
      Height          =   1095
      Left            =   0
      TabIndex        =   10
      Top             =   3105
      Width           =   1935
      Begin VB.CheckBox ParaCheck
         Caption         =   "Hanging"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   13
         Top             =   720
         Width           =   1600
      End
      Begin VB.CheckBox ParaCheck
         Caption         =   "Indent"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   12
         Top             =   480
         Width           =   1600
      End
      Begin VB.CheckBox ParaCheck
         Caption         =   "Bullet"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   11
         Top             =   240
         Width           =   1600
      End
   End
   Begin VB.Frame Frame2
      Caption         =   "Style"
      Height          =   1335
      Left            =   0
      TabIndex        =   5
      Top             =   1100
      Width           =   1935
      Begin VB.CheckBox StyleCheck
         Caption         =   "Underline"
         Height          =   255
         Index           =   3
         Left            =   240
         TabIndex        =   9
         Top             =   960
         Width           =   1095
      End
      Begin VB.CheckBox StyleCheck
         Caption         =   "Strikethru"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   8
         Top             =   720
         Width           =   1095
      End
      Begin VB.CheckBox StyleCheck
         Caption         =   "Italic"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   7
         Top             =   480
         Width           =   1095
      End
      Begin VB.CheckBox StyleCheck
         Caption         =   "Bold"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   6
         Top             =   240
         Width           =   1095
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Font"
      Height          =   1095
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   1935
      Begin VB.OptionButton FontOption
         Caption         =   "Times New Roman"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   4
         Top             =   720
         Width           =   1660
      End
      Begin VB.OptionButton FontOption
         Caption         =   "Courier New"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   3
         Top             =   480
         Width           =   1660
      End
      Begin VB.OptionButton FontOption
         Caption         =   "Arial"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   2
         Top             =   240
         Value           =   -1  'True
         Width           =   1660
      End
   End
   Begin RichtextLib.RichTextBox RichText
      Height          =   5295
      Left            =   1980
      TabIndex        =   0
      Top             =   0
      Width           =   4155
      _Version        =   65536
      _ExtentX        =   7329
      _ExtentY        =   9340
      _StockProps     =   69
      BackColor       =   -2147483643
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         name            =   "Arial"
         charset         =   0
         weight          =   400
         size            =   8.25
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      HideSelection   =   0   'False
      ScrollBars      =   3
      TextRTF         =   $"RICH.frx":0000
      BulletIndent    =   360
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
End
Attribute VB_Name = "RichForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Const MAX_FONT = 2
Const MAX_STYLE = 3
Const MAX_PARA = 2
Const MAX_ALIGN = 2

Dim SettingValues As Boolean

Const PARA_NONE = 0
Const PARA_BULLET = 1
Const PARA_INDENT = 2
Const PARA_HANGING = 3
Dim ParaStyle As Integer

Sub CheckParagraphOptions()
Dim i As Integer

    SettingValues = True

    ' Bullet.
    If IsNull(RichText.SelBullet) Then
        ParaCheck(0).Value = vbGrayed
    ElseIf RichText.SelBullet Then
        ParaCheck(0).Value = vbChecked
    Else
        ParaCheck(0).Value = vbUnchecked
    End If

    ' Indent.
    If RichText.SelIndent > 0 Then
        ParaCheck(1).Value = vbChecked
    Else
        ParaCheck(1).Value = vbUnchecked
    End If

    ' Hanging indent.
    If RichText.SelHangingIndent > 0 Then
        ParaCheck(2).Value = vbChecked
    Else
        ParaCheck(2).Value = vbUnchecked
    End If

    ' Select the correct alignment.
    Select Case RichText.SelAlignment
        Case rtfLeft
            AlignOption(0).Value = True
        Case rtfRight
            AlignOption(1).Value = True
        Case rtfCenter
            AlignOption(2).Value = True
        Case Else
            For i = 0 To MAX_ALIGN
                AlignOption(i).Value = False
            Next i
    End Select

    SettingValues = False
End Sub

Private Sub AlignOption_Click(Index As Integer)
    Select Case Index
        Case 0
            RichText.SelAlignment = rtfLeft
        Case 1
            RichText.SelAlignment = rtfRight
        Case 2
            RichText.SelAlignment = rtfCenter
    End Select
End Sub

Private Sub ColorSwatch_Click(Index As Integer)
    RichText.SelColor = CLng(ColorSwatch(Index).Tag)
End Sub

Private Sub FontOption_Click(Index As Integer)
    RichText.SelFontName = FontOption(Index).Caption
End Sub

Private Sub Form_Load()
Dim txt(1 To 6) As String
Dim all As String
Dim i As Integer
Dim offset As Integer

    txt(1) = _
    "The 32-bit versions of Visual Basic 4.0 includes " & _
    "the RichTextBox control. This control is similar " & _
    "to a text box but it is much more powerful. A rich " & _
    "text box can display multiple colors, fonts, and " & _
    "styles. It also includes a collection of useful " & _
    "text processing features like:" & vbCrLf

    txt(2) = "Paragraph alignment" & vbCrLf
    txt(3) = "Indentation" & vbCrLf
    txt(4) = "Hanging indentation" & vbCrLf
    txt(5) = "Bullets" & vbCrLf
    txt(6) = "Etc." & vbCrLf

    For i = 1 To 6
        all = all & txt(i)
    Next i
    RichText.Text = all

    offset = Len(txt(1))
    For i = 2 To 6
        RichText.SelStart = offset
        offset = offset + Len(txt(i))
        RichText.SelLength = 1
        RichText.SelBullet = True
    Next i
End Sub

' ***********************************************
' make the text box as big as possible.
' ***********************************************
Private Sub Form_Resize()
    RichText.Move Frame1.Width + 1, 0, ScaleWidth - Frame1.Width - 1, ScaleHeight
    RichText.RightMargin = RichText.Width - 120
End Sub





Private Sub mnuFileExit_Click()
    Unload Me
End Sub

Private Sub ParaCheck_Click(Index As Integer)
Dim v As Boolean

    If SettingValues Then Exit Sub

    v = (ParaCheck(Index).Value = vbChecked)
    Select Case Index
        Case 0
            RichText.SelBullet = v
        Case 1
            If v Then
                RichText.SelIndent = 360
            Else
                RichText.SelIndent = 0
            End If
        Case 2
            If v Then
                RichText.SelHangingIndent = 360
            Else
                RichText.SelHangingIndent = 0
            End If
    End Select

    ' Update the check box values.
    CheckParagraphOptions
End Sub


' ************************************************
' The selection or insertion point has changed.
' If there is a selection, activate the
' appropriate menu items.
' ************************************************
Private Sub RichText_SelChange()
Dim i As Integer

    SettingValues = True

    If RichText.SelLength <= 0 Then
        ' No text is selected.
        ' Disable the choices.
        For i = 0 To MAX_FONT
            FontOption(i).Enabled = False
            FontOption(i).Value = False
        Next i
        For i = 0 To MAX_STYLE
            StyleCheck(i).Enabled = False
            StyleCheck(i).Value = vbUnchecked
        Next i
    Else
        ' There is a selection.
        For i = 0 To MAX_FONT
            FontOption(i).Enabled = True
            FontOption(i).Value = False
        Next i
        For i = 0 To MAX_STYLE
            StyleCheck(i).Enabled = True
        Next i

        ' Select the correct font.
        Select Case RichText.SelFontName
            Case "Arial"
                FontOption(0).Value = True
            Case "Courier New"
                FontOption(1).Value = True
            Case "Times New Roman"
                FontOption(2).Value = True
        End Select

        ' Select the correct styles.
        If IsNull(RichText.SelBold) Then
            StyleCheck(0).Value = vbGrayed
        ElseIf RichText.SelBold Then
            StyleCheck(0).Value = vbChecked
        Else
            StyleCheck(0).Value = vbUnchecked
        End If
        If IsNull(RichText.SelItalic) Then
            StyleCheck(1).Value = vbGrayed
        ElseIf RichText.SelItalic Then
            StyleCheck(1).Value = vbChecked
        Else
            StyleCheck(1).Value = vbUnchecked
        End If
        If IsNull(RichText.SelStrikethru) Then
            StyleCheck(2).Value = vbGrayed
        ElseIf RichText.SelStrikethru Then
            StyleCheck(2).Value = vbChecked
        Else
            StyleCheck(2).Value = vbUnchecked
        End If
        If IsNull(RichText.SelUnderline) Then
            StyleCheck(3).Value = vbGrayed
        ElseIf RichText.SelUnderline Then
            StyleCheck(3).Value = vbChecked
        Else
            StyleCheck(3).Value = vbUnchecked
        End If
    End If

    SettingValues = False

    ' Select the correct paragraph options.
    CheckParagraphOptions
End Sub
Private Sub StyleCheck_Click(Index As Integer)
Dim v As Boolean

    If SettingValues Then Exit Sub

    v = (StyleCheck(Index).Value = vbChecked)
    Select Case Index
        Case 0
            RichText.SelBold = v
        Case 1
            RichText.SelItalic = v
        Case 2
            RichText.SelStrikethru = v
        Case 3
            RichText.SelUnderline = v
    End Select
End Sub